{-# OPTIONS_GHC -XRecordWildCards -XNamedFieldPuns -XDeriveDataTypeable -XTemplateHaskell -XTransformListComp #-}
module Hixay.UI.UserData where

import WS.Runtime.Xmlable
import WS.Runtime.DeriveXmlable
import Data.Typeable
import Data.List
import Data.Maybe
import XI.Directory.Types
import GHC.Exts(the)
import Control.Arrow

data UserSender = UserSender {
        uSender :: XISystem,
        usInts  :: [UserSInt]
    } deriving (Show, Eq, Typeable)

data UserSInt = UserSInt {
        usInt           :: String,
        usiPars         :: AdditionalParams,
        usiReceivers    :: [UserReceiver]
    } deriving (Show, Eq, Typeable)
    
data UserReceiver = UserReceiver {
        uReceiver   :: XISystem,
        urInts      :: [UserRInt]
    } deriving (Show, Eq, Typeable)
    
data UserRInt = UserRInt {
        urInt       :: String,
        uriPars     :: AdditionalParams
    } deriving (Show, Eq, Typeable)
    
data UserScenario = UserScenario {
        uScenario   :: String,
        uscShow     :: Bool,
        uscNotes    :: String
    } deriving (Show, Eq, Typeable)
    
$(deriveXmlableACDef ''UserRInt)
$(deriveXmlableACDef ''UserReceiver)
$(deriveXmlableACDef ''UserSInt)
$(deriveXmlableACDef ''UserSender)
$(deriveXmlableACDef ''UserScenario)


mergeUserData :: [Scenario] -> [UserSender] -> [UserScenario] -> ([Scenario], [UserSender], [UserScenario])
mergeUserData scs uss scns = (scsNew, ussNew, scnsNew)
    where
        ussNew = [
                UserSender { uSender = the s_sys, usInts = [
                        UserSInt { 
                                usInt = the s_int_s, 
                                usiPars = fromMaybe blank_ap $ getSPars (the s_sys) (the s_int_s), 
                                usiReceivers = [
                                        UserReceiver { uReceiver = the r_sys_si, urInts = 
                                                map (\ri -> UserRInt { 
                                                        urInt = r_int ri, 
                                                        uriPars = fromMaybe blank_ap $ getRPars (the s_sys) (the s_int_s) (the r_sys_si) (r_int ri)
                                                    }) $ nub $ concat r_ints_si
                                                } | 
                                        (r_sys_si, r_ints_si) <- map (r_sys &&& r_ints) $ nub $ concat receivers_s,
                                        then group by r_sys_si
                                    ] 
                            } |
                        (s_int_s, receivers_s) <- zip s_int receivers,
                        then group by s_int_s
                    ] } | 
                (s_sys, s_int, receivers) <- nub $ concatMap (
                        map (\(Chain {chain_sender = Sender {s_sys, s_int}, chain_receivers}) -> (s_sys, s_int, chain_receivers))
                        . scenario_chains
                    ) scs,
                then group by s_sys
            ]
        
        scnsNew = map (\sc -> UserScenario { 
                uScenario = sc, 
                uscShow = fromMaybe True $ getUscVal uscShow sc, 
                uscNotes = fromMaybe "" $ getUscVal uscNotes sc
            }) $ map (fromJust . scenario_name) $ filter (isJust . scenario_name) scs

        getSPars send si = listToMaybe [usiPars usi | us <- uss, usi <- usInts us, uSender us == send, usInt usi == si]
        getRPars send si rcv ri = listToMaybe [uriPars uri | us <- uss, usi <- usInts us, ur <- usiReceivers usi, uri <- urInts ur,
                uSender us == send, usInt usi == si, uReceiver ur == rcv, urInt uri == ri]

        getUscVal f sc = listToMaybe $ map f $ filter ((==sc) . uScenario) scns

        scsNew = [
                sc { scenario_chains = [
                        ch { chain_sender = send { s_params = getSPars (s_sys send) (s_int send) }, chain_receivers = [
                                r { r_ints = [
                                        ri { r_params = getRPars (s_sys send) (s_int send) (r_sys r) (r_int ri)} |
                                        ri <- r_ints r
                                    ] } |
                                r <- rcvs
                            ] } |
                        ch <- scenario_chains sc,
                        (send, rcvs) <- return $ chain_sender &&& chain_receivers $ ch
                    ], scenario_notes = scenario_name sc >>= getUscVal uscNotes } |
                sc <- filter (fromMaybe True . getUscVal uscShow . fromMaybe "" . scenario_name) scs
            ]
